home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
DOORS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-13
|
13KB
|
438 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }
unit doors;
interface
uses crt,gentypes,modem,configrt,gensubs,subs1,subs2,userret,statret,
textret,mainr1,mainr2;
procedure doorsmenu;
implementation
procedure doorsmenu;
function numdoors:integer;
begin
numdoors:=filesize (dofile)
end;
procedure seekdofile (n:integer);
begin
seek (dofile,n-1)
end;
procedure opendofile;
var arkanoid:integer;
begin
assign (dofile,bbsdatadir+'Doors.dat');
reset (dofile);
if ioresult<>0 then begin
close (dofile);
arkanoid:=ioresult;
rewrite (dofile)
end
end;
procedure maybemakebatch (fn:lstr);
var tf:text;
vallco:boolean;
begin
if not issysop then exit;
writestr ('Make new batch file '+fn+'? *');
if not yes then exit;
assign (tf,fn);
rewrite (tf);
if ioresult<>0 then begin
writeln (^M'Couldn''t create file!');
exit
end;
writeln (^M'Enter Text, blank line to end.'^M);
repeat
writestr ('─> &');
vallco:=length(input)=0;
if not vallco then writeln (tf,input)
until vallco;
textclose (tf);
writeln (^M'Batch file created!');
writelog (10,4,fn)
end;
procedure getdoorinfo (var d:doorrec);
var m:message;
begin
writeln (^B^M'Enter Info about this Door:'^M);
delay (1000);
titlestr:='Door Information';
d.info:=editor (m,false,'Door Information')
end;
function checkbatchname (var qq):boolean;
var i:lstr absolute qq;
batman:integer;
begin
batman:=pos('.',i);
if batman<>0 then i[0]:=chr(batman-1);
i:=i+'.BAT';
checkbatchname:=validfname(i)
end;
procedure maybemakedoor;
var shy:integer;
d:doorrec;
begin
if not issysop then exit;
shy:=numdoors+1;
writestr ('Make new Door #'+strr(shy)+'? *');
if not yes then exit;
writestr (^M'Name:');
if length(input)<1 then exit;
d.name:=input;
writestr ('Access Level:');
if length(input)<1 then exit;
d.level:=valu(input);
writestr ('Name/Path of batch file:');
if length(input)<1 then exit;
if not checkbatchname(input) then begin
writeln ('Invalid filename: '^S,input);
exit
end;
d.batchname:=doordir+input;
getdoorinfo (d);
if d.info<0 then exit;
d.numused:=0;
seekdofile (shy);
write (dofile,d);
if not exist (d.batchname) then begin
writeln (^B'ERROR: Can''t open Batch file ',d.batchname);
maybemakebatch (d.batchname)
end;
writeln (^B^M'Door created!');
writelog (10,3,d.name)
end;
function haveaccess (n:integer):boolean;
var d:doorrec;
begin
haveaccess:=false;
seekdofile (n);
read (dofile,d);
if ulvl>=d.level
then haveaccess:=true
else writeln ('That Door is locked.')
end;
procedure listdoors;
var d:doorrec;
cnt:integer;
begin
if exist (textfiledir+'DoorList.BBS') then begin
printfile (textfiledir+'DoorList.BBS');
exit
end;
if not (asciigraphics in urec.config) then begin
writehdr ('Available Doors');
seekdofile (1);
writeln (^M^R'## Online Door Name Level Times used');
for cnt:=1 to numdoors do begin
read (dofile,d);
if ulvl>=d.level then begin
tab (strr(cnt)+'.',3);
tab (d.name,27);
writeln (d.level:3,d.numused:5);
if break then exit
end
end;
end else begin
seekdofile (1);
writeln (^M^R'┌──┬──────────────────────────────┬─────┬──────────┐');
writeln (^R'│##│Online Door Name │Level│Times Used│');
writeln (^R'├──┼──────────────────────────────┼─────┼──────────┤');
for cnt:=1 to numdoors do begin
read (dofile,d);
if ulvl>=d.level then begin
tab (^R'│'^S+strr(cnt),5);
tab (^R'│'^S+d.name,33);
tab (^R'│'^S+strr(d.level),8);
tab (^R'│ '^S+strr(d.numused),13);
writeln (^R'│');
if break then exit
end
end
end;
if (asciigraphics in urec.config) then
writeln (^R'└──┴──────────────────────────────┴─────┴──────────┘')
end;
function getdoornum (txt:mstr):integer;
var g:boolean;
n:integer;
begin
getdoornum:=0;
g:=false;
repeat
writestr (^R'Door Number to '^P+txt+^R' ['^S'?/List'^R']:');
if input='?' then listdoors else g:=true
until g;
if length(input)=0 then exit;
n:=valu(input);
if (n<1) or (n>numdoors)
then writeln ('Door number out of range!')
else if haveaccess(n)
then getdoornum:=n
end;
procedure opendoor;
var n,bd,p:integer;
d:doorrec;
batchf,outf:text;
q:boolean;
tmp,params:lstr;
begin
n:=getdoornum ('open');
if n=0 then exit;
seekdofile (n);
read (dofile,d);
printtext (d.info);
nobreak:=true;
writestr (^B^M^P'Press ['^S'Space'^P'] to Open the Door, or ['^S'X'^P'] to Abort');
if upcase(waitforchar)='X' then exit;
writeln (^R'Opening door: '^S,d.name);
q:=true;
repeat
assign (batchf,d.batchname);
reset (batchf);
if ioresult<>0 then begin
q:=false;
close (batchf);
iocode:=ioresult;
if not issysop then begin
fileerror ('Opendoor',d.batchname);
exit
end else begin
maybemakebatch (d.batchname);
if not exist (d.batchname) then exit
end
end
until q;
assign (outf,'DOOR.BAT');
rewrite (outf);
writeln (outf,'TEMPDOOR ',params);
textclose (outf);
assign (outf,'TEMPDOOR.BAT');
rewrite (outf);
while not eof(batchf) do begin
readln (batchf,tmp);
writeln (outf,tmp)
end;
if online then bd:=baudrate else bd:=0;
getdir (0,tmp);
writeln (outf,'cd '+tmp);
writeln (outf,'main.bat ',unum,' ',bd,' ',ord(parity),' D');
textclose (batchf);
textclose (outf);
d.numused:=d.numused+1;
seekdofile (n);
write (dofile,d);
writelog (9,1,d.name);
updateuserstats (false);
writeurec;
writestatus;
ensureclosed;
halt (e_door)
end;
procedure getinfo;
var n:integer;
d:doorrec;
begin
n:=getdoornum ('get information on');
if n=0 then exit;
seekdofile (n);
read (dofile,d);
writeln;
printtext (d.info)
end;
procedure changedoor;
var n:integer;
d:doorrec;
begin
n:=getdoornum ('Change');
if n=0 then exit;
seekdofile (n);
read (dofile,d);
writeln ('Name: ',d.name);
writestr ('New name:');
if length(input)>0 then d.name:=input;
writeln (^M'Level: ',d.level);
writestr ('New level:');
if length(input)>0 then d.level:=valu(input);
writeln (^M'Batch file name: ',d.batchname);
writestr ('New batch file name:');
if length(input)>0 then
if checkbatchname (input)
then d.batchname:=input
else writeln ('Invalid filename: '^S,input);
maybemakebatch (d.batchname);
writeln;
printtext (d.info);
writestr (^M^R'Replace text ['^S'y/n'^R']:');
if yes then repeat
deletetext (d.info);
getdoorinfo (d);
if d.info<0 then writeln (^M'You must enter some information.')
until d.info>=0;
seekdofile (n);
write (dofile,d);
writelog (10,1,d.name)
end;
procedure deletedoor;
var n,cnt:integer;
td,d:doorrec;
f:file;
begin
n:=getdoornum ('Delete');
if n=0 then exit;
seekdofile (n);
read (dofile,d);
writestr ('Delete '+d.name+' [y/n]:');
if not yes then exit;
writeln ('Deleting...');
seekdofile (n+1);
for cnt:=n to filesize(dofile)-1 do begin
read (dofile,td);
seekdofile (cnt);
write (dofile,td)
end;
seek (dofile,filesize(dofile)-1);
truncate (dofile);
deletetext (d.info);
writestr (^M'Erase disk file '+d.batchname+'? *');
if yes then begin
assign (f,d.batchname);
erase (f);
if ioresult<>0 then writeln ('(File not found)')
end;
writelog (10,2,d.name)
end;
procedure sysopdoors;
var zebra:integer;
begin
if (not remotedoors) and carrier then begin
writestr ('Sorry, remote door maintenance is not allowed!');
writestr ('(Re-configure to change this setting)');
exit
end;
repeat
zebra:=menu('Doors Sysop','SDOORS','QCAD?');
case zebra of
2:changedoor;
3:maybemakedoor;
4:deletedoor;
5:begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
Doors Sysop Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔════
s');
writeln ('u
═════════════════════════════════╗HC║ [
A
]
s');
writeln ('u
Add Door
║HC║ [
C
s');
writeln ('u
]
Change Door
║HC║ [
s');
writeln ('u
D
]
Delete Door
║H
s');
writeln ('u
C║ [
Q
]
Quit
s');
writeln ('u
║HC║ [
?
]
View This Menu
s');
writeln ('u
║HC╚═════════════════════════════════════╝
');
writeln;
pause;
end;
end
until hungupon or (zebra=1) or (filesize(dofile)=0)
end;
var x1,x2,x3,space,harrier,zebra:integer;
y1,y2,y3:real;
begin
writeln ('On-Line Doors');
if not allowdoors then begin
writestr ('All doors are locked.');
if issysop then writestr ('[Re-configure to change this setting]');
exit
end;
if fromdoor then begin
fromdoor:=false;
if returnto='D' then writestr (^M^M'Welcome back to FAQ!');
settimeleft (urec.timetoday)
end;
x1:=urec.nbu;
x2:=urec.numon;
if x1<1 then x1:=1;
if x2<1 then x2:=1;
y1:=int(x1);
y2:=int(x2);
y1:=y1;
y2:=y2;
y3:=y1/y2;
y3:=y3*100;
x3:=trunc(y3);
write (^R'Required Post/Call Ratio: ['^S);
for space:=1 to 3-(length(strr(doorpcr))) do write (' ');
write (strr(doorpcr));
writeln ('%'^R']');
write (^R'Your Post/Call Ratio: ['^S);
for harrier:=1 to 3-(length(strr(x3))) do write (' ');
write (strr(x3));
writeln ('%'^R']');
write (^M^R'PCR Status: ['^S);
if ulvl>=pcrexempt then write ('Exempt from PCR.') else
if (x3<doorpcr) and (ulvl<pcrexempt) then write ('PCR too low!') else
if (x3>=doorpcr) and (ulvl<pcrexempt) then write ('Passed PCR check.');
writeln (^R']'^M);
if (x3<doorpcr) and (ulvl<pcrexempt) then begin
writeln (^B^R'Your Posts-per-Call Ratio is too low!');
writeln ('Go post a message or two.');
exit;
end;
cursection:=doorssysop;
opendofile;
if numdoors=0 then begin
writestr ('No doors exist!');
maybemakedoor;
if numdoors=0 then begin
close (dofile);
exit
end
end;
writehdr ('Doors');
repeat
zebra:=menu('Doors','DOORS','QLOI%?');
case zebra of
2:listdoors;
3:opendoor;
4:getinfo;
5:sysopdoors;
6:begin
writeln ('
C
╔═════════════════════════════════════╗H
s');
writeln ('u
C║
Doors Section
║H
s');
writeln ('u
C╚═════════════════════════════════════╝HHC╔════
s');
writeln ('u
═════════════════════════════════╗HC║ [
I
]
s');
writeln ('u
Get Info on Door
║HC║ [
L
s');
writeln ('u
]
List Doors
║HC║ [
s');
writeln ('u
O
]
Open (Run) Door
║H
s');
writeln ('u
C║ [
Q
]
Quit
s');
writeln ('u
║HC║ [
%
]
Doors Sysop Section
s');
writeln ('u
║HC║ [
?
]
View This Menu
s');
writeln ('u
║HC╚═══════════════════════════════
A');
writeln ('C
══════╝
');
writeln;
pause;
end;
end
until hungupon or (zebra=1) or (filesize(dofile)=0);
close (dofile)
end;
begin
end.